R Notebook

Dieses Notebook bereitet die Daten für die Intelligent Zoning Engine vor. Es speichert

• entities.geojson — Schulen, deren Geokoordinaten und Attribute: entity_id, capacity, und andere Attribute
• entities.csv — Statistische Blöcke Berlins und optimierungsrelevante Attribute: entity_id, capacity
• units.geojson — Statistische Blöcke Berlins, deren Geometrie und Attribute
• units.csv — Statsitische Blöcke Berlins und optimierungsrelevante Attribute: unit_id, population, percentage_sgb
• weights.csv — optimierungsrelevante Gewichte wie Fußwege / Spalten: entity_id, unit_id, weight, value
• assignment.csv — eine initiale Zuordnung / Spalten: unit_id, entity_id

Bereits in anderen scripten wurde vorbereitet:

• Fußwegen von einer großen Sichprobe von (Wohn-)Gebäuden zu allen Schulen wurden berechnet und in route_matrix.csv gespeichert
• Die Stichprobe wurde in sampled_buildings.csv gespeichert

Die Daten werden wiefolgt vorbereitet:

• pro Block werden die Anzahl der einzuschulenden Kinder mit Hilfe der Einwohnerzahlen nach Alter auf LOR-Ebene in EWR201512E_Matrix.csv hochgerechnet
  • Kinder des LOR werden Anteilig nach Einwohnerzahl des Blocks im Verhältnis zum LOR auf die Blöcke verteilt
• es werden minimale, durchschnittliche und maximale Fußwege aus jedem Block errechnet

TODO: - die sozioökonomischen Faktoren werden aus den Wahlbezirken auf die Blöcke hochgerechnet (https://github.com/berlinermorgenpost/cogran)

Laden der Daten

re_schulstand = readOGR('download/re_schulstand.geojson', layer = 'OGRGeoJSON')

OGR data source with driver: GeoJSON 
Source: "download/re_schulstand.geojson", layer: "OGRGeoJSON"
with 709 features
It has 20 fields

Schulwege

Schulkapazitäten und Einwohnerzahler auf LOR-Ebene

kapas = read_csv('download/anmeldezahlen.csv') %>% filter(grepl('G', Schulnummer)) %>% filter(!is.na(`Plätze`))
einwohner_lor = read_delim('download/EWR201512E_Matrix.csv', delim=';')

Überprüfung der Vollständigkeit der Daten über Anmeldezahlen/Kapazitäten

re_schulstand_df = re_schulstand %>% as.data.frame() %>% rename(lon=coords.x1, lat=coords.x2)
re_schulstand_df %>% filter(grepl('G', spatial_name)) %>% mutate(BEZIRK=enc2utf8(as.character(BEZIRK))) %>%
  group_by(BEZIRK) %>% summarise(`Anzahl Schulen` = n()) %>%
  rename(Bezirk=BEZIRK) %>% left_join(kapas %>% group_by(Bezirk) %>% summarise(`Mit Kapazität` = n()))

Joining, by = "Bezirk"

Für welche Bezirke haben wir für alle Schulen Kapazitäten gegeben?

re_schulstand %>% as.data.frame() %>% filter(grepl('G', spatial_name)) %>% mutate(BEZIRK=enc2utf8(as.character(BEZIRK))) %>% group_by(BEZIRK) %>% summarise(`Anzahl Schulen` = n()) %>%
  rename(Bezirk=BEZIRK) %>% left_join(kapas %>% group_by(Bezirk) %>% summarise(`Mit Kapazität` = n())) %>% filter(`Anzahl Schulen` == `Mit Kapazität`)

Joining, by = "Bezirk"

Überprüfung ob die Liste der Schulen und Liste der Schulen mit Kapazitätsinformationen gleich sind:

bezirk = 'Tempelhof-Schöneberg'
schulen_mit_kapa = kapas %>% filter(Bezirk == bezirk) %>% .$Schulnummer
schulen_mit_kapa

 [1] "07G01" "07G02" "07G03" "07G05" "07G06" "07G07" "07G10" "07G12" "07G13" "07G14" "07G15" "07G16" "07G17" "07G18" "07G19" "07G20" "07G21" "07G22"
[19] "07G23" "07G24" "07G25" "07G26" "07G27" "07G28" "07G29" "07G30" "07G31" "07G32" "07G34" "07G35" "07G36" "07G37"

grundschulen = re_schulstand %>% as.data.frame() %>% filter(grepl('G', spatial_name)) %>% filter(BEZIRK == bezirk) %>% .$spatial_name
'In Anmeldeliste, fehlt in Schulstand'

[1] "In Anmeldeliste, fehlt in Schulstand"

setdiff(schulen_mit_kapa, grundschulen)

character(0)

'In re_schulstand, fehlt in Anmeldeliste'

[1] "In re_schulstand, fehlt in Anmeldeliste"

setdiff(grundschulen, schulen_mit_kapa)

character(0)

map = get_map('Berlin')

Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=Berlin&zoom=10&size=640x640&scale=2&maptype=terrain&language=en-EN&sensor=false
Information from URL : http://maps.googleapis.com/maps/api/geocode/json?address=Berlin&sensor=false

re_schulstand_df_w_kapas = re_schulstand_df %>% left_join(kapas, by=c('spatial_name'='Schulnummer'))

joining character vector and factor, coercing into character vector

Plot aller Schulen, mit der Info, ob Kapazitätsinformationen verfügbar sind.

data = re_schulstand_df_w_kapas %>% filter(grepl('G', spatial_name)) %>% filter(BEZIRK==bezirk) %>% mutate(missing.capa=is.na(`Plätze`))
ggmap(map) + geom_point(aes(lon, lat, color=missing.capa), data=data) +
    coord_map(xlim=c(min(data$lon)-0.01, max(data$lon)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

Filter auf Schulen mit Kapazitätsinformationen (für T-S sind das alle):

relevant_schools = re_schulstand_df %>% filter(grepl('G', spatial_name)) %>% filter(BEZIRK==bezirk & !is.na(`Plätze`)) %>% .$spatial_name
relevant_schools

Mapping Bezirk->LOR->Block

df_bez = as.data.frame(bez)
df_lor = as.data.frame(lor)
df_blk = as.data.frame(blk)

Sanity-Check: LORs und Blöcke im Bezirk

bez_id = filter(df_bez, BEZNAME == bezirk)$BEZ
relevant_lors = df_lor %>% filter(BEZ == bez_id)
relevant_blks = df_blk %>% filter(BEZ == bez_id)

ggplot() + geom_path(aes(x=long, y=lat, group=group), data=lor[lor$BEZ == bez_id,]) + coord_map() + geom_path(aes(x=long, y=lat, group=group), data=bez, color='red')

Regions defined for each Polygons
Regions defined for each Polygons

Blöcke im Bezirk

ggplot() + geom_path(aes(x=long, y=lat, group=group), data=blk[blk$BEZ == bez_id,]) + coord_map() + geom_path(aes(x=long, y=lat, group=group), data=bez[bez$BEZ == bez_id,], color='red')

Regions defined for each Polygons
Regions defined for each Polygons

Kinder im Bezirk auf Blöcke hochrechnen

Über die Einwohnerinformationen in RBS_OD_BLK_2015_12.geojson kann EWR201512E_Matrix.csv von LOR-Ebene auf Blockebene hochgerechnet werden.

TODO: Stattdessen mit https://github.com/berlinermorgenpost/cogran machen?

Plot der 6-Jährigen nach EWR201512E_Matrix.csv

TODO neue Daten von Torres? TODO Mittel über mehrere Jahre verwenden? Prognose?

relevant_ewr = einwohner_lor %>% select(RAUMID, E_E06_07) %>% filter(RAUMID %in% relevant_lors$PLR) %>%
  mutate(kids=as.numeric(gsub(',','.',E_E06_07))) %>% as.data.frame()
data = tidy(lor[lor$BEZ == bez_id,], region='PLR') %>% inner_join(relevant_ewr, by=c('id'='RAUMID'))
ggmap(map) + geom_polygon(aes(x=long, y=lat, group=group, fill=kids), data=data) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

Plot der Einwohner auf Blockebene

data = tidy(blk[blk$BEZ == bez_id,], region='BLK') %>% inner_join(df_blk, by=c('id'='BLK')) %>% mutate(Einw=ifelse(Einw==0, NA, Einw))

joining character vector and factor, coercing into character vector

0

[1] 0

ggmap(map) + geom_polygon(aes(x=long, y=lat, group=group, fill=Einw), data=data) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

Hochrrechnung auf Blöcke

kids_in_blks = relevant_blks %>% group_by(PLR) %>% mutate(EinwRatio = Einw/sum(Einw)) %>% ungroup %>% left_join(relevant_ewr, by=c('PLR'='RAUMID')) %>% mutate(kids = EinwRatio*kids) %>% select(BEZ, PLR, BLK, Einw, kids) %>% as.data.frame()

joining character vector and factor, coercing into character vector

row.names(kids_in_blks) = kids_in_blks$BLK
data = tidy(blk[blk$BEZ == bez_id,], region='BLK') %>% inner_join(kids_in_blks, by=c('id'='BLK')) %>% mutate(kids=ifelse(kids==0, NA, kids), Einw=ifelse(Einw==0, NA, Einw))

joining character vector and factor, coercing into character vector

0

[1] 0

ggmap(map) + geom_polygon(aes(x=long, y=lat, group=group, fill=kids), data=data) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

Verfügbare Plätze

Überprüfung der Summe der Kapazitäten, Anmeldungen und Kinderstatistiken

'Summe Kapas'

[1] "Summe Kapas"

relevant_kapas %>% .$Kapa %>% sum

[1] 2584

'Anmeldungen'

[1] "Anmeldungen"

kapas %>% mutate(Anmeldungen = as.numeric(gsub('[^0-9]', '', Anmeldungen))) %>% filter(Schulnummer %in% relevant_schools) %>% .$Anmeldungen %>% sum

[1] 2752

'Kids laut Statistik'

[1] "Kids laut Statistik"

kids_in_blks$kids %>% sum

[1] 2855

relevant_ewr$kids %>% sum

[1] 2855

Schulwege von Blöcken zu Schulen aggregieren

Für jedes Wohngebäude suchen wir den zugehörigen Block

residential_buildings_blocks = sampled_buildings %>% inner_join(df_blk) %>% filter(BEZ == bez_id)

Joining, by = "BLK"

residential_buildings_blocks

routes_from_blks = residential_buildings_blocks %>%
  left_join(route_matrix %>% filter(dst %in% relevant_schools), by=c('OI'='src'))

joining character vector and factor, coercing into character vector

head(routes_from_blks)

Plot der relevanten Blöcke (mit Wohngebäuden)

data = tidy(blk[blk$BEZ == bez_id,], region='BLK') %>% inner_join(routes_from_blks %>% group_by(BLK) %>% summarise(n=n()), by=c('id'='BLK'))

joining character vector and factor, coercing into character vector

ggmap(map) + geom_polygon(aes(x=long, y=lat, group=group), fill='red', data=data) +
  #geom_point(aes(x=lon, y=lat), data=rb_df, color='black', size=0.01) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

travel_from_blks = routes_from_blks %>% as.data.frame() %>% group_by(BLK, dst) %>% summarise(min=min(distance), avg=mean(distance), med=median(distance), max=max(distance)) %>% ungroup
travel_from_blks

Plot der Blöcke mit Färbung nach durchschnittlichem Weg zur nächsten Schule

data = tidy(blk[blk$BEZ == bez_id,], region='BLK') %>% left_join(travel_from_blks %>% group_by(BLK) %>% top_n(1, -avg), by=c('id'='BLK'))

joining factor and character vector, coercing into character vector

ggmap(map) + geom_polygon(aes(x=long, y=lat, group=group, fill=-avg), data=data) +
  geom_point(aes(lon, lat), color='red', data = re_schulstand_df %>% filter(BEZIRK==bezirk & SCHULART=='Grundschule')) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01))

travel_matrix = travel_from_blks %>% select(BLK, dst, avg) %>% spread(dst, avg)
dim(travel_matrix)

[1] 1012   33

travel_matrix

Select relevant data

optim_kapas = relevant_kapas
optim_kids_in_blks = kids_in_blks %>% filter(kids > 0) %>% inner_join(travel_matrix, by='BLK') %>% select(BLK, kids) %>% mutate(kids=kids)
nrow(optim_kids_in_blks)

[1] 1012

nrow(optim_kapas)

[1] 32

select_schools = as.character(optim_kapas$Schulnummer)
select_blks = as.character(optim_kids_in_blks$BLK)
optim_matrix = inner_join(optim_kids_in_blks, travel_matrix, by='BLK')[select_schools]
dim(optim_matrix)

[1] 1012   32

optim_kapas$Kapa %>% sum

[1] 2584

optim_kids_in_blks$kids %>% sum

[1] 2844.886

Naive Zuordnung: Jeder Block zur nächsten Schule

solution = optim_matrix %>% mutate(BLK=optim_kids_in_blks$BLK) %>% gather(school, dist, -BLK) %>% group_by(BLK) %>% top_n(1, -dist) %>% ungroup
optim_matrix %>% t %>% as.data.frame %>% summarise_each(funs(min)) %>% sum()

[1] 786223.1

solines = re_schulstand_df %>% inner_join(solution, by=c('spatial_name'='school')) %>% inner_join(cbind(as.data.frame(coordinates(blk[blk$BEZ == bez_id,])), blk[blk$BEZ == bez_id,]@data['BLK']))

joining factor and character vector, coercing into character vectorJoining, by = "BLK"

data = tidy(blk[blk$BEZ == bez_id,], region='BLK') %>% left_join(solution, by=c('id'='BLK'))

joining factor and character vector, coercing into character vector

ggmap(map, darken = c(0.5, 'white')) + geom_polygon(aes(x=long, y=lat, group=group, fill=school), data=data) +
  geom_segment(aes(x=V1,y=V2,xend=lon,yend=lat), data=solines, size=0.3) +
  geom_point(aes(lon, lat), color='black', size=2, data = re_schulstand_df %>% inner_join(solution, by=c('spatial_name'='school'))) +
  geom_point(aes(lon, lat, color=spatial_name), data = re_schulstand_df %>% inner_join(solution, by=c('spatial_name'='school'))) +
  coord_map(xlim=c(min(data$long)-0.01, max(data$long)+0.01), ylim=c(min(data$lat)-0.01, max(data$lat)+0.01)) +
  guides(color=F, fill=F)

joining factor and character vector, coercing into character vectorjoining factor and character vector, coercing into character vector

Darstellung der Zuordnung als Tabelle

library(formattable)

solution %>% inner_join(optim_kids_in_blks, by='BLK') %>% inner_join(travel_from_blks, by=c('BLK'='BLK', 'school'='dst')) %>%
  group_by(school) %>% summarise(
    kids=sum(kids),
    num_blocks=n(),
    min_dist=min(min),
    avg_dist=mean((kids*avg)/sum(kids)),
    max_dist=max(max)
  ) %>%
  inner_join(relevant_kapas, by=c('school'='Schulnummer')) %>%
  mutate(
    utilization=kids/Kapa
  ) %>% select(
   Schule=school,
   `Blöcke`=num_blocks,
   Kapazität=Kapa,
   Kinder=kids,
   Auslastung=utilization,
   `Weg (min)`=min_dist,
   `Weg (Ø)`=avg_dist,
   `Weg (max)`=max_dist
  ) %>%
  formattable(
    list(
      Kinder = formatter("span", x ~ digits(x, 2)),
      Auslastung = formatter("span",
        style = x ~ style(color = ifelse(x < 1, "green", "red")),
        x ~ icontext(ifelse(x < 1, "ok", "remove"), percent(x))
      ),
      `Weg (Ø)` = proportion_bar("lightblue"),
      `Weg (min)` = proportion_bar("lightblue"),
      `Weg (max)` = proportion_bar("lightblue")
    )
  )

Daten für die App speichern

• entities.geojson
• entities.csv
• units.geojson
• units.csv
• weights.csv
• assignment.csv

Neue Daten

TODO

Alte Daten

write_rds(solution, 'app/data/init_solution.rds', 'gz')
write_rds(subset(blk, BEZ == bez_id), 'app/data/blocks.rds', 'gz')
write_rds(subset(re_schulstand_df, spatial_name %in% relevant_schools), 'app/data/schools.rds', 'gz')
write_rds(subset(bez, BEZ == bez_id), 'app/data/bez.rds', 'gz')
block_stats = optim_kids_in_blks %>% inner_join(travel_from_blks, by=c('BLK'='BLK')) %>% inner_join(relevant_kapas, by=c('dst'='Schulnummer')) %>% inner_join(re_schulstand_df, by=c('dst'='spatial_name'))

joining character vector and factor, coercing into character vector

write_rds(block_stats, 'app/data/block_stats.rds', 'gz')